{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving #-}
module LLVM.Parser.Record.TreeGenerator.Instances where 

import LLVM.Parser.Record.Record
import LLVM.Parser.Record.Parser
import LLVM.Util

import Data.EitherLike
import Data.TreeLike
import Data.PairLike

import Control.Monad
import Control.Monad.State


import Control.Monad.TreeGenerator


instance PairLike BlockHeader [RawBlockElem] RawBlock where
        toPair (RawBlock x y) = (x,y)
        fromPair (x,y) = RawBlock x y     

instance EitherLike RawRecord RawBlock RawBlockElem where
        toEither (Data rec) = Left rec
        toEither (Sub sub) = Right sub
        left rec = Data rec
        right sub = Sub sub
 
instance TreeLike [RawBlockElem] BlockHeader RawRecord where
        tlempty = []
        tlnull = null
        tlconsLeaf el tr = Data el : tr
        tlconsBranch hd sub tr = (Sub $ RawBlock hd sub) : tr
        tlhead [] = error "tlhead called on empty RawBlock"
        tlhead (h:_) = mapEitherLikes id toPair h
        tltail = tail
        
        
type ElemCollector = TreeGeneratorT BlockHeader RawRecord [RawBlockElem] ErrParser ()


                
